#' Control Function for Descriptive Statistics

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Sets a list of parameters for summaries of descriptive statistics. Typically used internally to specify

#' details for [s_summary()]. This function family is mainly used by [analyze_vars()].

#'

#' @inheritParams argument_convention

#' @param quantiles (`numeric`)\cr of length two to specify the quantiles to calculate.

#' @param quantile_type (`numeric`)\cr between 1 and 9 selecting quantile algorithms to be used.

#'   Default is set to 2 as this matches the default quantile algorithm in SAS `proc univariate` set by `QNTLDEF=5`.

#'   This differs from R's default. See more about `type` in [stats::quantile()].

#' @param test_mean (`numeric`)\cr to test against the mean under the null hypothesis when calculating p-value.

#'

#' @note Deprecation cycle started for `control_summarize_vars` as it is going to renamed into

#'   `control_analyze_vars`. Intention is to reflect better the core underlying `rtables`

#'   functions; in this case [analyze_vars()] wraps [rtables::analyze()].

#'

#' @return A list of components with the same names as the arguments.

#'

#' @export control_analyze_vars control_summarize_vars

#' @aliases control_summarize_vars

control_analyze_vars <- function(conf_level = 0.95,

                                 quantiles = c(0.25, 0.75),

                                 quantile_type = 2,

                                 test_mean = 0) {

}

control_summarize_vars <- control_analyze_vars

#' Format Function for Descriptive Statistics

#'

#' Returns format patterns for descriptive statistics. The format is understood by the `rtables`.

#'

#' @param type (`string`)\cr choice of a summary data type. Only `counts` and `numeric` types are currently supported.

#'

#' @return A named `vector` of default statistic formats for the given data type.

#'

#' @keywords internal

summary_formats <- function(type = "numeric") {

    )

  } else {

    )

  }

}

#' Label Function for Descriptive Statistics

#'

#' Returns labels of descriptive statistics for numeric variables.

#'

#' @return A named `vector` of default statistic labels.

#'

#' @keywords internal

summary_labels <- function() {

  )

}

#' Analyze Variables

#'

#' @description `r lifecycle::badge("stable")`

#'

#' We use the S3 generic function [s_summary()] to implement summaries for different `x` objects. This

#' is used as a statistics function in combination with the analyze function [analyze_vars()].

#'

#' @inheritParams argument_convention

#'

#' @name analyze_variables

NULL

#' @describeIn analyze_variables S3 generic function to produces a variable summary.

#'

#' @return

#' * `s_summary()` returns different statistics depending on the class of `x`.

#'

#' @export

s_summary <- function(x,

                      na.rm = TRUE, # nolint

                      denom,

                      .N_row, # nolint

                      .N_col, # nolint

                      .var,

                      ...) {

}

#' @describeIn analyze_variables Method for `numeric` class.

#'

#' @param control (`list`)\cr parameters for descriptive statistics details, specified by using

#'   the helper function [control_analyze_vars()]. Some possible parameter options are:

#'   * `conf_level` (`proportion`)\cr confidence level of the interval for mean and median.

#'   * `quantiles` (`numeric`)\cr vector of length two to specify the quantiles.

#'   * `quantile_type` (`numeric`)\cr between 1 and 9 selecting quantile algorithms to be used.

#'     See more about `type` in [stats::quantile()].

#'   * `test_mean` (`numeric`)\cr value to test against the mean under the null hypothesis when calculating p-value.

#'

#' @return

#'   * If `x` is of class `numeric`, returns a `list` with the following named `numeric` items:

#'     * `n`: The [length()] of `x`.

#'     * `sum`: The [sum()] of `x`.

#'     * `mean`: The [mean()] of `x`.

#'     * `sd`: The [stats::sd()] of `x`.

#'     * `se`: The standard error of `x` mean, i.e.: (`sd(x) / sqrt(length(x))`).

#'     * `mean_sd`: The [mean()] and [stats::sd()] of `x`.

#'     * `mean_se`: The [mean()] of `x` and its standard error (see above).

#'     * `mean_ci`: The CI for the mean of `x` (from [stat_mean_ci()]).

#'     * `mean_sei`: The SE interval for the mean of `x`, i.e.: ([mean()] -/+ [stats::sd()] / [sqrt()]).

#'     * `mean_sdi`: The SD interval for the mean of `x`, i.e.: ([mean()] -/+ [stats::sd()]).

#'     * `mean_pval`: The two-sided p-value of the mean of `x` (from [stat_mean_pval()]).

#'     * `median`: The [stats::median()] of `x`.

#'     * `mad`: The median absolute deviation of `x`, i.e.: ([stats::median()] of `xc`,

#'       where `xc` = `x` - [stats::median()]).

#'     * `median_ci`: The CI for the median of `x` (from [stat_median_ci()]).

#'     * `quantiles`: Two sample quantiles of `x` (from [stats::quantile()]).

#'     * `iqr`: The [stats::IQR()] of `x`.

#'     * `range`: The [range_noinf()] of `x`.

#'     * `min`: The [max()] of `x`.

#'     * `max`: The [min()] of `x`.

#'     * `median_range`: The [median()] and [range_noinf()] of `x`.

#'     * `cv`: The coefficient of variation of `x`, i.e.: ([stats::sd()] / [mean()] * 100).

#'     * `geom_mean`: The geometric mean of `x`, i.e.: (`exp(mean(log(x)))`).

#'     * `geom_cv`: The geometric coefficient of variation of `x`, i.e.: (`sqrt(exp(sd(log(x)) ^ 2) - 1) * 100`).

#'

#' @note

#' * If `x` is an empty vector, `NA` is returned. This is the expected feature so as to return `rcell` content in

#'   `rtables` when the intersection of a column and a row delimits an empty data selection.

#' * When the `mean` function is applied to an empty vector, `NA` will be returned instead of `NaN`, the latter

#'   being standard behavior in R.

#'

#' @method s_summary numeric

#'

#' @examples

#' # `s_summary.numeric`

#'

#' ## Basic usage: empty numeric returns NA-filled items.

#' s_summary(numeric())

#'

#' ## Management of NA values.

#' x <- c(NA_real_, 1)

#' s_summary(x, na.rm = TRUE)

#' s_summary(x, na.rm = FALSE)

#'

#' x <- c(NA_real_, 1, 2)

#' s_summary(x, stats = NULL)

#'

#' ## Benefits in `rtables` contructions:

#' require(rtables)

#' dta_test <- data.frame(

#'   Group = rep(LETTERS[1:3], each = 2),

#'   sub_group = rep(letters[1:2], each = 3),

#'   x = 1:6

#' )

#'

#' ## The summary obtained in with `rtables`:

#' basic_table() %>%

#'   split_cols_by(var = "Group") %>%

#'   split_rows_by(var = "sub_group") %>%

#'   analyze(vars = "x", afun = s_summary) %>%

#'   build_table(df = dta_test)

#'

#' ## By comparison with `lapply`:

#' X <- split(dta_test, f = with(dta_test, interaction(Group, sub_group)))

#' lapply(X, function(x) s_summary(x$x))

#'

#' @export

s_summary.numeric <- function(x,

                              na.rm = TRUE, # nolint

                              denom,

                              .N_row, # nolint

                              .N_col, # nolint

                              .var,

                              control = control_analyze_vars(),

                              ...) {

  }

  } else {

  }

  ))

  # Convert negative values to NA for log calculation.

}

#' @describeIn analyze_variables Method for `factor` class.

#'

#' @param denom (`string`)\cr choice of denominator for factor proportions. Options are:

#'   * `n`: number of values in this row and column intersection.

#'   * `N_row`: total number of values in this row across columns.

#'   * `N_col`: total number of values in this column across rows.

#'

#' @return

#'   * If `x` is of class `factor` or converted from `character`, returns a `list` with named `numeric` items:

#'     * `n`: The [length()] of `x`.

#'     * `count`: A list with the number of cases for each level of the factor `x`.

#'     * `count_fraction`: Similar to `count` but also includes the proportion of cases for each level of the

#'       factor `x` relative to the denominator, or `NA` if the denominator is zero.

#'

#' @note

#' * If `x` is an empty `factor`, a list is still returned for `counts` with one element

#'   per factor level. If there are no levels in `x`, the function fails.

#' * If factor variables contain `NA`, these `NA` values are excluded by default. To include `NA` values

#'   set `na.rm = FALSE` and missing values will be displayed as an `NA` level. Alternatively, an explicit

#'   factor level can be defined for `NA` values during pre-processing via [df_explicit_na()] - the

#'   default `na_level` (`"<Missing>"`) will also be excluded when `na.rm` is set to `TRUE`.

#'

#' @method s_summary factor

#'

#' @examples

#' # `s_summary.factor`

#'

#' ## Basic usage:

#' s_summary(factor(c("a", "a", "b", "c", "a")))

#' # Empty factor returns NA-filled items.

#' s_summary(factor(levels = c("a", "b", "c")))

#'

#' ## Management of NA values.

#' x <- factor(c(NA, "Female"))

#' x <- explicit_na(x)

#' s_summary(x, na.rm = TRUE)

#' s_summary(x, na.rm = FALSE)

#'

#' ## Different denominators.

#' x <- factor(c("a", "a", "b", "c", "a"))

#' s_summary(x, denom = "N_row", .N_row = 10L)

#' s_summary(x, denom = "N_col", .N_col = 20L)

#'

#' @export

s_summary.factor <- function(x,

                             na.rm = TRUE, # nolint

                             denom = c("n", "N_row", "N_col"),

                             .N_row, # nolint

                             .N_col, # nolint

                             ...) {

  } else {

  }

  )

    }

  )

}

#' @describeIn analyze_variables Method for `character` class. This makes an automatic

#'   conversion to factor (with a warning) and then forwards to the method for factors.

#'

#' @param verbose (`logical`)\cr Defaults to `TRUE`, which prints out warnings and messages. It is mainly used

#'   to print out information about factor casting.

#'

#' @note

#' * Automatic conversion of character to factor does not guarantee that the table

#'   can be generated correctly. In particular for sparse tables this very likely can fail.

#'   It is therefore better to always pre-process the dataset such that factors are manually

#'   created from character variables before passing the dataset to [rtables::build_table()].

#'

#' @method s_summary character

#'

#' @examples

#' # `s_summary.character`

#'

#' ## Basic usage:

#' s_summary(c("a", "a", "b", "c", "a"), .var = "x", verbose = FALSE)

#' s_summary(c("a", "a", "b", "c", "a", ""), .var = "x", na.rm = FALSE, verbose = FALSE)

#'

#' @export

s_summary.character <- function(x,

                                na.rm = TRUE, # nolint

                                denom = c("n", "N_row", "N_col"),

                                .N_row, # nolint

                                .N_col, # nolint

                                .var,

                                verbose = TRUE,

                                ...) {

  } else {

  }

    ...

  )

}

#' @describeIn analyze_variables Method for `logical` class.

#'

#' @param denom (`string`)\cr choice of denominator for proportion. Options are:

#'   * `n`: number of values in this row and column intersection.

#'   * `N_row`: total number of values in this row across columns.

#'   * `N_col`: total number of values in this column across rows.

#'

#' @return

#'   * If `x` is of class `logical`, returns a `list` with named `numeric` items:

#'     * `n`: The [length()] of `x` (possibly after removing `NA`s).

#'     * `count`: Count of `TRUE` in `x`.

#'     * `count_fraction`: Count and proportion of `TRUE` in `x` relative to the denominator, or `NA` if the

#'       denominator is zero. Note that `NA`s in `x` are never counted or leading to `NA` here.

#'

#' @method s_summary logical

#'

#' @examples

#' # `s_summary.logical`

#'

#' ## Basic usage:

#' s_summary(c(TRUE, FALSE, TRUE, TRUE))

#'

#' ## Management of NA values.

#' x <- c(NA, TRUE, FALSE)

#' s_summary(x, na.rm = TRUE)

#' s_summary(x, na.rm = FALSE)

#'

#' ## Different denominators.

#' x <- c(TRUE, FALSE, TRUE, TRUE)

#' s_summary(x, denom = "N_row", .N_row = 10L)

#' s_summary(x, denom = "N_col", .N_col = 20L)

#'

#' @export

s_summary.logical <- function(x,

                              na.rm = TRUE, # nolint

                              denom = c("n", "N_row", "N_col"),

                              .N_row, # nolint

                              .N_col, # nolint

                              ...) {

  )

}

#' @describeIn analyze_variables Formatted analysis function which is used as `afun` in `analyze_vars()`.

#'

#' @return

#' * `a_summary()` returns the corresponding list with formatted [rtables::CellValue()].

#'

#' @export

a_summary <- function(x,

                      ...,

                      .N_row, # nolint

                      .N_col, # nolint

                      .var) {

}

.a_summary_numeric_formats <- summary_formats()

.a_summary_numeric_labels <- summary_labels()

#' @describeIn analyze_variables Formatted analysis function method for `numeric` class.

#'

#' @examples

#' # `a_summary.numeric`

#' a_summary(rnorm(10), .N_col = 10, .N_row = 20, .var = "bla")

#'

#' @export

a_summary.numeric <- make_afun(

  s_summary.numeric,

  .formats = .a_summary_numeric_formats,

  .labels = .a_summary_numeric_labels

)

.a_summary_counts_formats <- summary_formats(type = "counts")

#' @describeIn analyze_variables Formatted analysis function method for `factor` class.

#'

#' @examples

#' # `a_summary.factor`

#' # We need to ungroup `count` and `count_fraction` first so that the rtables formatting

#' # functions can be applied correctly.

#' afun <- make_afun(

#'   getS3method("a_summary", "factor"),

#'   .ungroup_stats = c("count", "count_fraction")

#' )

#' afun(factor(c("a", "a", "b", "c", "a")), .N_row = 10, .N_col = 10)

#'

#' @export

a_summary.factor <- make_afun(

  s_summary.factor,

  .formats = .a_summary_counts_formats

)

#' @describeIn analyze_variables Formatted analysis function method for `character` class.

#'

#' @examples

#' # `a_summary.character`

#' afun <- make_afun(

#'   getS3method("a_summary", "character"),

#'   .ungroup_stats = c("count", "count_fraction")

#' )

#' afun(c("A", "B", "A", "C"), .var = "x", .N_col = 10, .N_row = 10, verbose = FALSE)

#'

#' @export

a_summary.character <- make_afun(

  s_summary.character,

  .formats = .a_summary_counts_formats

)

#' @describeIn analyze_variables Formatted analysis function method for `logical` class.

#'

#' @examples

#' # `a_summary.logical`

#' afun <- make_afun(

#'   getS3method("a_summary", "logical")

#' )

#' afun(c(TRUE, FALSE, FALSE, TRUE, TRUE), .N_row = 10, .N_col = 10)

#'

#' @export

a_summary.logical <- make_afun(

  s_summary.logical,

  .formats = .a_summary_counts_formats

)

#' Constructor Function for [analyze_vars()] and [summarize_colvars()]

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Constructor function which creates a combined formatted analysis function.

#'

#' @inheritParams argument_convention

#' @param .indent_mods (named `vector` of `integer`)\cr indent modifiers for the labels. Each element of the vector

#'   should be a name-value pair with name corresponding to a statistic specified in `.stats` and value the indentation

#'   for that statistic's row label.

#'

#' @return Combined formatted analysis function for use in [analyze_vars()].

#'

#' @note Since [a_summary()] is generic and we want customization of the formatting arguments

#'   via [rtables::make_afun()], we need to create another temporary generic function, with

#'   corresponding customized methods. Then in order for the methods to be found,

#'   we need to wrap them in a combined `afun`. Since this is required by two layout creating

#'   functions (and possibly others in the future), we provide a constructor that does this:

#'   [create_afun_summary()].

#'

#' @examples

#' # `create_afun_summary()` to create combined `afun`

#'

#' afun <- create_afun_summary(

#'   .stats = NULL,

#'   .formats = c(median = "xx."),

#'   .labels = c(median = "My median"),

#'   .indent_mods = c(median = 1L)

#' )

#' ## Fabricated dataset.

#' dta_test <- data.frame(

#'   USUBJID = rep(1:6, each = 3),

#'   PARAMCD = rep("lab", 6 * 3),

#'   AVISIT  = rep(paste0("V", 1:3), 6),

#'   ARM     = rep(LETTERS[1:3], rep(6, 3)),

#'   AVAL    = c(9:1, rep(NA, 9))

#' )

#'

#' l <- basic_table() %>%

#'   split_cols_by(var = "ARM") %>%

#'   split_rows_by(var = "AVISIT") %>%

#'   analyze(vars = "AVAL", afun = afun)

#'

#' build_table(l, df = dta_test)

#'

#' @export

create_afun_summary <- function(.stats, .formats, .labels, .indent_mods) {

           ...,

    }

    )

    )

    )

    )

    )

      ...,

    )

  }

}

#' @describeIn analyze_variables Layout-creating function which can take statistics function arguments

#'   and additional format arguments. This function is a wrapper for [rtables::analyze()].

#'

#' @param ... arguments passed to `s_summary()`.

#' @param .indent_mods (named `vector` of `integer`)\cr indent modifiers for the labels. Each element of the vector

#'   should be a name-value pair with name corresponding to a statistic specified in `.stats` and value the indentation

#'   for that statistic's row label.

#'

#' @note Deprecation cycle started for `summarize_vars` as it is going to renamed into

#'   `analyze_vars`. Intention is to reflect better the core underlying `rtables`

#'   functions; in this case [rtables::analyze()].

#'

#' @return

#' * `analyze_vars()` returns a layout object suitable for passing to further layouting functions,

#'   or to [rtables::build_table()]. Adding this function to an `rtable` layout will add formatted rows containing

#'   the statistics from `s_summary()` to the table layout.

#'

#' @examples

#' ## Fabricated dataset.

#' dta_test <- data.frame(

#'   USUBJID = rep(1:6, each = 3),

#'   PARAMCD = rep("lab", 6 * 3),

#'   AVISIT  = rep(paste0("V", 1:3), 6),

#'   ARM     = rep(LETTERS[1:3], rep(6, 3)),

#'   AVAL    = c(9:1, rep(NA, 9))

#' )

#'

#' # `analyze_vars()` in `rtables` pipelines

#' ## Default output within a `rtables` pipeline.

#' l <- basic_table() %>%

#'   split_cols_by(var = "ARM") %>%

#'   split_rows_by(var = "AVISIT") %>%

#'   analyze_vars(vars = "AVAL")

#'

#' build_table(l, df = dta_test)

#'

#' ## Select and format statistics output.

#' l <- basic_table() %>%

#'   split_cols_by(var = "ARM") %>%

#'   split_rows_by(var = "AVISIT") %>%

#'   analyze_vars(

#'     vars = "AVAL",

#'     .stats = c("n", "mean_sd", "quantiles"),

#'     .formats = c("mean_sd" = "xx.x, xx.x"),

#'     .labels = c(n = "n", mean_sd = "Mean, SD", quantiles = c("Q1 - Q3"))

#'   )

#'

#' results <- build_table(l, df = dta_test)

#' as_html(results)

#'

#' ## Use arguments interpreted by `s_summary`.

#' l <- basic_table() %>%

#'   split_cols_by(var = "ARM") %>%

#'   split_rows_by(var = "AVISIT") %>%

#'   analyze_vars(vars = "AVAL", na.rm = FALSE)

#'

#' results <- build_table(l, df = dta_test)

#'

#' ## Handle `NA` levels first when summarizing factors.

#' dta_test$AVISIT <- NA_character_

#' dta_test <- df_explicit_na(dta_test)

#' l <- basic_table() %>%

#'   split_cols_by(var = "ARM") %>%

#'   analyze_vars(vars = "AVISIT", na.rm = FALSE)

#'

#' results <- build_table(l, df = dta_test)

#' \donttest{

#' Viewer(results)

#' }

#'

#' @export analyze_vars summarize_vars

#' @aliases summarize_vars

analyze_vars <- function(lyt,

                         vars,

                         var_labels = vars,

                         nested = TRUE,

                         ...,

                         na_level = NA_character_,

                         show_labels = "default",

                         table_names = vars,

                         section_div = NA_character_,

                         .stats = c("n", "mean_sd", "median", "range", "count_fraction"),

                         .formats = NULL,

                         .labels = NULL,

                         .indent_mods = NULL) {

  )

}

summarize_vars <- analyze_vars

#' Helper Function to create a new `SMQ` variable in `ADAE` by stacking `SMQ` and/or `CQ` records.

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Helper Function to create a new `SMQ` variable in `ADAE` that consists of all adverse events belonging to

#' selected Standardized/Customized queries. The new dataset will only contain records of the adverse events

#' belonging to any of the selected baskets.

#'

#' @inheritParams argument_convention

#' @param baskets (`character`)\cr variable names of the selected Standardized/Customized queries.

#' @param smq_varlabel (`string`)\cr a label for the new variable created.

#' @param keys (`character`)\cr names of the key variables to be returned along with the new variable created.

#' @param aag_summary (`data.frame`)\cr containing the `SMQ` baskets and the levels of interest for the final `SMQ`

#'   variable. This is useful when there are some levels of interest that are not observed in the `df` dataset.

#'   The two columns of this dataset should be named `basket` and `basket_name`.

#'

#' @return `data.frame` with variables in `keys` taken from `df` and new variable `SMQ` containing

#'   records belonging to the baskets selected via the `baskets` argument.

#'

#' @examples

#' adae <- tern_ex_adae[1:20, ] %>% df_explicit_na()

#' h_stack_by_baskets(df = adae)

#'

#' aag <- data.frame(

#'   NAMVAR = c("CQ01NAM", "CQ02NAM", "SMQ01NAM", "SMQ02NAM"),

#'   REFNAME = c(

#'     "D.2.1.5.3/A.1.1.1.1 AESI", "X.9.9.9.9/Y.8.8.8.8 AESI",

#'     "C.1.1.1.3/B.2.2.3.1 AESI", "C.1.1.1.3/B.3.3.3.3 AESI"

#'   ),

#'   SCOPE = c("", "", "BROAD", "BROAD"),

#'   stringsAsFactors = FALSE

#' )

#'

#' basket_name <- character(nrow(aag))

#' cq_pos <- grep("^(CQ).+NAM$", aag$NAMVAR)

#' smq_pos <- grep("^(SMQ).+NAM$", aag$NAMVAR)

#' basket_name[cq_pos] <- aag$REFNAME[cq_pos]

#' basket_name[smq_pos] <- paste0(

#'   aag$REFNAME[smq_pos], "(", aag$SCOPE[smq_pos], ")"

#' )

#'

#' aag_summary <- data.frame(

#'   basket = aag$NAMVAR,

#'   basket_name = basket_name,

#'   stringsAsFactors = TRUE

#' )

#'

#' result <- h_stack_by_baskets(df = adae, aag_summary = aag_summary)

#' all(levels(aag_summary$basket_name) %in% levels(result$SMQ))

#'

#' h_stack_by_baskets(

#'   df = adae,

#'   aag_summary = NULL,

#'   keys = c("STUDYID", "USUBJID", "AEDECOD", "ARM"),

#'   baskets = "SMQ01NAM"

#' )

#'

#' @export

h_stack_by_baskets <- function(df,

                               baskets = grep("^(SMQ|CQ).+NAM$", names(df), value = TRUE),

                               smq_varlabel = "Standardized MedDRA Query",

                               keys = c("STUDYID", "USUBJID", "ASTDTM", "AEDECOD", "AESEQ"),

                               aag_summary = NULL,

                               na_level = "<Missing>") {

  # Use of df_explicit_na() in case the user has not previously used

  # SC corresponding to NAM

    )

    # Warning in case there is no match between `aag_summary$basket` and `baskets` argument.

    # Honestly, I think those should completely match. Target baskets should be the same.

    }

  }

  # convert `na_level` records from baskets to NA for the later loop and from wide to long steps

  } else {

    # Concatenate SMQxxxNAM with corresponding SMQxxxSC

    }

    # have to convert df_cnct from tibble to dataframe

    # as it throws a warning otherwise about rownames.

    # tibble do not support rownames and reshape creates rownames

    )

  }

    # A warning in case there is no match between df and aag_summary records

    }

        )

      )

    )

  } else {

    )

  }

}

#' Helper Functions for Tabulating Binary Response by Subgroup

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Helper functions that tabulate in a data frame statistics such as response rate

#' and odds ratio for population subgroups.

#'

#' @inheritParams argument_convention

#' @inheritParams response_subgroups

#' @param arm (`factor`)\cr the treatment group variable.

#'

#' @details Main functionality is to prepare data for use in a layout-creating function.

#'

#' @examples

#' library(dplyr)

#' library(forcats)

#'

#' adrs <- tern_ex_adrs

#' adrs_labels <- formatters::var_labels(adrs)

#'

#' adrs_f <- adrs %>%

#'   filter(PARAMCD == "BESRSPI") %>%

#'   filter(ARM %in% c("A: Drug X", "B: Placebo")) %>%

#'   droplevels() %>%

#'   mutate(

#'     # Reorder levels of factor to make the placebo group the reference arm.

#'     ARM = fct_relevel(ARM, "B: Placebo"),

#'     rsp = AVALC == "CR"

#'   )

#' formatters::var_labels(adrs_f) <- c(adrs_labels, "Response")

#'

#' @name h_response_subgroups

NULL

#' @describeIn h_response_subgroups helper to prepare a data frame of binary responses by arm.

#'

#' @return

#' * `h_proportion_df()` returns a `data.frame` with columns `arm`, `n`, `n_rsp`, and `prop`.

#'

#' @examples

#' h_proportion_df(

#'   c(TRUE, FALSE, FALSE),

#'   arm = factor(c("A", "A", "B"), levels = c("A", "B"))

#' )

#'

#' @export

h_proportion_df <- function(rsp, arm) {

      )

    } else {

      )

    }

}

#' @describeIn h_response_subgroups summarizes proportion of binary responses by arm and across subgroups

#'    in a data frame. `variables` corresponds to the names of variables found in `data`, passed as a named list and

#'    requires elements `rsp`, `arm` and optionally `subgroups`. `groups_lists` optionally specifies

#'    groupings for `subgroups` variables.

#'

#' @return

#' * `h_proportion_subgroups_df()` returns a `data.frame` with columns `arm`, `n`, `n_rsp`, `prop`, `subgroup`,

#'   `var`, `var_label`, and `row_type`.

#'

#' @examples

#' h_proportion_subgroups_df(

#'   variables = list(rsp = "rsp", arm = "ARM", subgroups = c("SEX", "BMRKR2")),

#'   data = adrs_f

#' )

#'

#' # Define groupings for BMRKR2 levels.

#' h_proportion_subgroups_df(

#'   variables = list(rsp = "rsp", arm = "ARM", subgroups = c("SEX", "BMRKR2")),

#'   data = adrs_f,

#'   groups_lists = list(

#'     BMRKR2 = list(

#'       "low" = "LOW",

#'       "low/medium" = c("LOW", "MEDIUM"),

#'       "low/medium/high" = c("LOW", "MEDIUM", "HIGH")

#'     )

#'   )

#' )

#'

#' @export

h_proportion_subgroups_df <- function(variables,

                                      data,

                                      groups_lists = list(),

                                      label_all = "All Patients") {

  # Add All Patients.

  # Add Subgroups.

  } else {

    })

    )

  }

}

#' @describeIn h_response_subgroups helper to prepare a data frame with estimates of

#'   the odds ratio between a treatment and a control arm.

#'

#' @inheritParams response_subgroups

#' @param strata_data (`factor`, `data.frame` or `NULL`)\cr required if stratified analysis is performed.

#'

#' @return

#' * `h_odds_ratio_df()` returns a `data.frame` with columns `arm`, `n_tot`, `or`, `lcl`, `ucl`, `conf_level`, and

#'   optionally `pval` and `pval_label`.

#'

#' @examples

#' # Unstratatified analysis.

#' h_odds_ratio_df(

#'   c(TRUE, FALSE, FALSE, TRUE),

#'   arm = factor(c("A", "A", "B", "B"), levels = c("A", "B"))

#' )

#'

#' # Include p-value.

#' h_odds_ratio_df(adrs_f$rsp, adrs_f$ARM, method = "chisq")

#'

#' # Stratatified analysis.

#' h_odds_ratio_df(

#'   rsp = adrs_f$rsp,

#'   arm = adrs_f$ARM,

#'   strata_data = adrs_f[, c("STRATA1", "STRATA2")],

#'   method = "cmh"

#' )

#'

#' @export

h_odds_ratio_df <- function(rsp, arm, strata_data = NULL, conf_level = 0.95, method = NULL) {

  )

  } else {

  }

    # Odds ratio and CI.

    )

      # Dummy column needed downstream to create a nested header.

    )

      # Test for difference.

      )

    }

    # In those cases cannot go through the model so will obtain n_tot from data.

  } else if (

  ) {

      # Dummy column needed downstream to create a nested header.

    )

    }

  } else {

      # Dummy column needed downstream to create a nested header.

    )

    }

  }

}

#' @describeIn h_response_subgroups summarizes estimates of the odds ratio between a treatment and a control

#'   arm across subgroups in a data frame. `variables` corresponds to the names of variables found in

#'   `data`, passed as a named list and requires elements `rsp`, `arm` and optionally `subgroups`

#'   and `strat`. `groups_lists` optionally specifies groupings for `subgroups` variables.

#'

#' @return

#' * `h_odds_ratio_subgroups_df()` returns a `data.frame` with columns `arm`, `n_tot`, `or`, `lcl`, `ucl`,

#'   `conf_level`, `subgroup`, `var`, `var_label`, and `row_type`.

#'

#' @examples

#' # Unstratified analysis.

#' h_odds_ratio_subgroups_df(

#'   variables = list(rsp = "rsp", arm = "ARM", subgroups = c("SEX", "BMRKR2")),

#'   data = adrs_f

#' )

#'

#' # Stratified analysis.

#' h_odds_ratio_subgroups_df(

#'   variables = list(

#'     rsp = "rsp",

#'     arm = "ARM",

#'     subgroups = c("SEX", "BMRKR2"),

#'     strat = c("STRATA1", "STRATA2")

#'   ),

#'   data = adrs_f

#' )

#'

#' # Define groupings of BMRKR2 levels.

#' h_odds_ratio_subgroups_df(

#'   variables = list(

#'     rsp = "rsp",

#'     arm = "ARM",

#'     subgroups = c("SEX", "BMRKR2")

#'   ),

#'   data = adrs_f,

#'   groups_lists = list(

#'     BMRKR2 = list(

#'       "low" = "LOW",

#'       "low/medium" = c("LOW", "MEDIUM"),

#'       "low/medium/high" = c("LOW", "MEDIUM", "HIGH")

#'     )

#'   )

#' )

#'

#' @export

h_odds_ratio_subgroups_df <- function(variables,

                                      data,

                                      groups_lists = list(),

                                      conf_level = 0.95,

                                      method = NULL,

                                      label_all = "All Patients") {

  } else {

  }

  # Add All Patients.

  )

  } else {

      } else {

      }

      )

    })

    )

  }

}

#' Confidence Intervals for a Difference of Binomials

#'

#' @description `r lifecycle::badge("experimental")`

#'

#' Several confidence intervals for the difference between proportions.

#'

#' @param grp (`factor`)\cr vector assigning observations to one out of two groups

#'   (e.g. reference and treatment group).

#'

#' @name desctools_binom

NULL

#' Recycle List of Parameters

#'

#' This function recycles all supplied elements to the maximal dimension.

#'

#' @param ... (`any`)\cr Elements to recycle.

#'

#' @return A `list`.

#'

#' @keywords internal

#' @noRd

h_recycle <- function(...) {

}

#' @describeIn desctools_binom Several confidence intervals for the difference between proportions.

#'

#' @return A `matrix` of 3 values:

#'   * `est`: estimate of proportion difference.

#'   * `lwr.ci`: estimate of lower end of the confidence interval.

#'   * `upr.ci`: estimate of upper end of the confidence interval.

#'

#' @keywords internal

desctools_binom <- function(x1, n1, x2, n2, conf.level = 0.95, sides = c( # nolint

                              "two.sided",

                              "left", "right"

                            ), method = c(

                              "ac", "wald", "waldcc", "score",

                              "scorecc", "mn", "mee", "blj", "ha", "hal", "jp"

                            )) {

  }

  }

    }

      },

      },

      },

      },

        )

        )

      },

        )

        )

      },

          } else {

          }

        }

          )

        }

      },